home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / diskchk.pas < prev    next >
Pascal/Delphi Source File  |  1986-09-11  |  27KB  |  826 lines
  1. {*************************************************************************}
  2. {*         Copyright (c) Kim Kokkonen, TurboPower Software, 1986         *}
  3. {*  Released to the public domain for personal, non-commercial use only  *}
  4. {*************************************************************************}
  5. {.F-}
  6. {
  7. This program analyzes any set of files on any MSDOS disk drive to
  8. determine a measure of performance efficiency. The performance measure
  9. is based on how many sets of file sectors are not contiguous. When
  10. the sectors of a file are not contiguous, read and write times are
  11. longer since the drive heads are forced to seek to each non-contiguous
  12. sector.
  13.  
  14. MSDOS Wildcards can be used to select any desired group of files in
  15. any drive or directory. A "Recursive" option allows you to look at
  16. all subdirectories of the start directory, and thus the entire disk
  17. if desired.
  18.  
  19. Output includes a list of all files analyzed with various analytical
  20. information. Optionally, only those files with non-contiguous sectors
  21. can be listed. The output is written to STDOUT, so that it can be
  22. redirected or piped.
  23.  
  24. A final summary section gives statistics for all of the files analyzed.
  25. This section is not redirectable.
  26.  
  27. Examples:
  28.  
  29. DISKCHK -?
  30.   writes a help screen and halts.
  31.  
  32. DISKCHK
  33.   looks at all files in the current directory and writes to screen.
  34.  
  35. DISKCHK C:\*.COM -R >BREAKS.DAT
  36.   looks at all COM files on drive C: and writes those with breaks
  37.   to the file BREAKS.DAT.
  38.  
  39. DISKCHK A: | MORE
  40.   pages all files in the root directory of drive A: through the
  41.   DOS MORE filter.
  42.  
  43. Written 1/21/86. Kim Kokkonen, TurboPower Software.
  44. 408-378-3672. Compuserve 72457,2131.
  45.  
  46. Requires Turbo Pascal version 3 to compile.
  47. No known dependencies on the PCDOS version of Turbo.
  48. Compile with max heap = $A000 to allow maximum recursion
  49. area for subdirectory searching.
  50. }
  51. {.F+}
  52. {$P512}
  53. {$C-}
  54.  
  55. PROGRAM DiskEfficiency(Output);
  56.   {-measure the fraction of non-contiguous sectors in a group of files}
  57. CONST
  58.   MaxFiles = 1024;            {max number of files searched in a given directory}
  59.   MaxDirs = 128;              {maximum number of dirs in a given directory}
  60.   OptionChar = '-';           {character which prefixes options on command line}
  61.   version : string[4] = '1.00';
  62.  
  63. TYPE
  64.   DriveName = STRING[2];
  65.   FileString = STRING[12];
  66.   PathName = STRING[64];
  67.   FileName = STRING[8];
  68.   ExtName = STRING[3];
  69.   LongString = STRING[255];
  70.   FnameType = ARRAY[0..7] OF Char;
  71.   FextType = ARRAY[0..2] OF Char;
  72.   FATinRAM = ARRAY[0..32767] OF Byte;
  73.  
  74.   Darray =
  75.   RECORD
  76.     num : Integer;
  77.     arr : ARRAY[1..MaxDirs] OF FileString;
  78.   END;
  79.  
  80.   CompositeFilename =
  81.   RECORD
  82.     name : FileName;
  83.     ext : ExtName;
  84.   END;
  85.  
  86.   Farray =
  87.   RECORD
  88.     num : Integer;
  89.     arr : ARRAY[1..MaxFiles] OF CompositeFilename;
  90.   END;
  91.  
  92.   DTArec =
  93.   RECORD
  94.     DOSnext : ARRAY[1..21] OF Byte;
  95.     attr : Byte;
  96.     fTime, fDate, flSize, fhSize : Integer;
  97.     FullName : ARRAY[1..13] OF Char;
  98.   END;
  99.  
  100.   UnopenedFCBrec =
  101.   RECORD
  102.     flag : Byte;
  103.     junk : ARRAY[0..4] OF Byte;
  104.     SearchAttr : Byte;
  105.     drive : Byte;
  106.     fName : FnameType;
  107.     fExt : FextType;
  108.     attr : Byte;
  109.     DOSnext : ARRAY[12..21] OF Byte;
  110.     fTime, fDate, fCluster, flSize, fhSize : Integer;
  111.   END;
  112.  
  113.   Registers =
  114.   RECORD
  115.     CASE Integer OF
  116.       1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
  117.       2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  118.   END;
  119.  
  120. VAR
  121.   reg : Registers;
  122.   SavePath, StartPath : PathName;
  123.   ConsoleOut, WroteFile, bigFAT, recursive, verbose : Boolean;
  124.   dta : DTArec;
  125.   tStart, tStop : Real;
  126.   err : Text[128];            {non-redirectable status output written here}
  127.   files : Farray;
  128.   FATbytes, FATsectors, secSize, AvailableClusters, fBroken,
  129.   TotalBreaks, ClustersUsed, fCount, alloUnits, secsPerAllo : Integer;
  130.   FAT : ^FATinRAM;
  131.  
  132.   PROCEDURE error(errnum, erraddr : Integer);
  133.     {-get back to home in case of a crash}
  134.   BEGIN
  135.     ChDir(SavePath);
  136.     Halt(1);
  137.   END;
  138.  
  139.   PROCEDURE Time(VAR sec : Real);
  140.     {-return time of day in seconds since midnight}
  141.   BEGIN
  142.     reg.ah := $2C;
  143.     MsDos(reg);
  144.     sec := 1.0*(reg.dh+60.0*(reg.cl+60.0*reg.ch)+reg.dl/100.0);
  145.   END;                        {time}
  146.  
  147.   PROCEDURE DoHalt(exitcode : Integer);
  148.     {-halt}
  149.   BEGIN
  150.     ChDir(SavePath);
  151.     Halt(exitcode);
  152.   END;                        {dohalt}
  153.  
  154.   FUNCTION BreakPressed : Boolean;
  155.     {-true if Break key has been pressed}
  156.     {-note that keypressed function executes int 23 if ^C has been pressed}
  157.   VAR
  158.     c : Char;
  159.     breakdown : Boolean;
  160.   BEGIN
  161.     {check current state}
  162.     breakdown := False;
  163.     WHILE KeyPressed AND NOT(breakdown) DO BEGIN
  164.       Read(Kbd, c);
  165.       IF c = ^C THEN breakdown := True;
  166.     END;
  167.     BreakPressed := breakdown;
  168.   END;                        {breakpressed}
  169.  
  170.   PROCEDURE BreakHalt;
  171.     {-executed when break is detected}
  172.     {-exit with return code 1}
  173.   BEGIN
  174.     ChDir(SavePath);
  175.     Halt(1);
  176.   END;                        {breakhalt}
  177.  
  178.   PROCEDURE SetBreak;
  179.     {-set the ctrl-break address to a process exit handler}
  180.   BEGIN
  181.     reg.ax := $2523;
  182.     reg.ds := CSeg;
  183.     reg.dx := Ofs(BreakHalt);
  184.     MsDos(reg);
  185.   END;                        {setbreak}
  186.  
  187.   FUNCTION IOstat(bit : Integer) : Boolean;
  188.     {-check status of the standard I/O}
  189.     {bit=0 for input, 1 for output}
  190.     {returns true if I/O is through console}
  191.   VAR
  192.     temp0, temp1 : Boolean;
  193.   BEGIN
  194.     reg.ax := $4400;
  195.     reg.bx := bit {standard input or output} ;
  196.     MsDos(reg);
  197.     temp0 := reg.dx AND 128 <> 0;
  198.     temp1 := reg.dx AND (1 SHL bit) <> 0;
  199.     iostat := temp0 AND temp1;
  200.   END {iostat} ;
  201.  
  202.   PROCEDURE ParsePath(VAR start : PathName;
  203.                       VAR dName : DriveName;
  204.                       VAR pName : PathName;
  205.                       VAR fName : FileString);
  206.     {-parse a full (perhaps incomplete) pathname into component parts}
  207.   VAR
  208.     i : Integer;
  209.  
  210.     FUNCTION FileExists(s : PathName; attr : Integer) : Boolean;
  211.       {-determine whether a file exists with the specified attribute}
  212.     BEGIN
  213.       reg.ah := $4E;
  214.       s[Succ(Length(s))] := #0;
  215.       reg.ds := Seg(s);
  216.       reg.dx := Ofs(s[1]);
  217.       reg.cx := attr;
  218.       MsDos(reg);
  219.       FileExists := ((reg.flags AND 1) = 0) AND ((dta.attr AND 31) = attr);
  220.     END;                      {fileexists}
  221.  
  222.   BEGIN
  223.     {get drive name}
  224.     i := Pos(':', start);
  225.     IF i = 0 THEN BEGIN
  226.       dName := '';
  227.       pName := start;
  228.     END ELSE BEGIN
  229.       dName := Copy(start, 1, i);
  230.       IF i = Length(start) THEN pName := '\'
  231.       ELSE pName := Copy(start, Succ(i), 64);
  232.     END;
  233.  
  234.     {see if wildcard specified}
  235.     i := Pos('*', start)+Pos('?', start);
  236.  
  237.     {separate out filename and pathname}
  238.     IF (i = 0) AND (FileExists(start, 16) OR (pName = '\')) THEN BEGIN
  239.       {start specifies a subdirectory}
  240.       fName := '*.*';
  241.       IF pName <> '\' THEN pName := pName+'\';
  242.     END ELSE BEGIN
  243.       {parse out filename on end}
  244.       i := Length(pName);
  245.       WHILE (i > 0) AND NOT(pName[i] IN [':', '\', '/']) DO i := Pred(i);
  246.       fName := Copy(pName, Succ(i), 63);
  247.       pName := Copy(pName, 1, i);
  248.       IF pName = '' THEN GetDir(0, pName);
  249.       IF pName[Length(pName)] <> '\' THEN pName := pName+'\';
  250.     END;
  251.   END;                        {parsepath}
  252.  
  253.   FUNCTION Path(dName : DriveName; pName : PathName) : PathName;
  254.     {-return legal pathname for chdir}
  255.   VAR
  256.     t : PathName;
  257.   BEGIN
  258.     t := dName;
  259.     IF pName = '\' THEN
  260.       t := t+pName
  261.     ELSE
  262.       t := t+Copy(pName, 1, Pred(Length(pName)));
  263.     Path := t;
  264.   END;                        {path}
  265.  
  266.   FUNCTION ReturnDriveNum(dName : DriveName) : Byte;
  267.     {-return the drive number for an FCB call, 1=A, 2=B}
  268.   CONST
  269.     DriveLets : STRING[26] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  270.   BEGIN
  271.     IF dName = '' THEN
  272.       ReturnDriveNum := 0
  273.     ELSE
  274.       ReturnDriveNum := Pos(UpCase(dName[1]), DriveLets);
  275.   END;                        {returndrivenum}
  276.  
  277.   FUNCTION StUpcase(s : LongString) : LongString;
  278.     {-return the uppercase of a string}
  279.   VAR
  280.     i : Byte;
  281.   BEGIN
  282.     FOR i := 1 TO Length(s) DO s[i] := UpCase(s[i]);
  283.     StUpcase := s;
  284.   END;                        {stupcase}
  285.  
  286.   PROCEDURE SetOptions;
  287.     {-read command line and set up options and defaults}
  288.   VAR
  289.     i : Integer;
  290.     c : Char;
  291.     HaltSoon : Boolean;
  292.     param : LongString;
  293.  
  294.     PROCEDURE WriteHelp;
  295.     BEGIN
  296.       WriteLn(err, 'Usage: DISKCHK [Options] [SearchPath] [>ResultFile]');
  297.       WriteLn(err);
  298.       WriteLn(err, '  DISKCHK measures the storage efficiency of any group of files on');
  299.       WriteLn(err, '  any floppy or hard disk supported by MSDOS. It returns a list of');
  300.       WriteLn(err, '  files with the number of clusters used, the number of non-contiguous');
  301.       WriteLn(err, '  clusters and a measure of the efficiency of storage as it will affect');
  302.       WriteLn(err, '  read/write performance. If all clusters are contiguous, the efficiency');
  303.       WriteLn(err, '  is rated as 100%. Otherwise, the efficiency is downgraded by the');
  304.       WriteLn(err, '  percentage of clusters that are non-contiguous.');
  305.       WriteLn(err);
  306.       WriteLn(err, '  If no options are specified, the files in the current drive and');
  307.       WriteLn(err, '  directory are analyzed, and a report listing all non-contiguous');
  308.       WriteLn(err, '  files found is written to the standard output.');
  309.       WriteLn(err);
  310.       WriteLn(err, 'Options:');
  311.       WriteLn(err, '  SearchPath    Start in the specified drive and directory, and search');
  312.       writeln(err, '                those files matching any filespec given (wildcards ok).');
  313.       writeln(err, '                If not specified, all files in current dir are analyzed.');
  314.       WriteLn(err, '  -R            search Recursively, down all subdirectories found.');
  315.       WriteLn(err, '  -V            Verbose mode. Write all files, including contiguous ones.');
  316.       WriteLn(err, '  -A            Automatic mode. Analyzes entire default drive.');
  317.       WriteLn(err, '  -?            write this Help message.');
  318.       DoHalt(2);
  319.     END;                      {writehelp}
  320.  
  321.     PROCEDURE DoError(message : LongString);
  322.       {-display an error message}
  323.     BEGIN
  324.       WriteLn(err, message);
  325.       HaltSoon := True;
  326.     END;                      {doerror}
  327.  
  328.   BEGIN
  329.     {get options}
  330.     WriteLn(err);
  331.     HaltSoon := False;
  332.     i := 1;
  333.     WHILE i <= ParamCount DO BEGIN
  334.       {analyze options}
  335.       param := ParamStr(i);
  336.       IF param[1] = OptionChar THEN BEGIN
  337.         {an option}
  338.         IF Length(param) = 2 THEN BEGIN
  339.           c := UpCase(param[2]);
  340.           CASE c OF
  341.             '?' : WriteHelp;
  342.             'R' : recursive := True;
  343.             'V' : verbose := true;
  344.             'A' : BEGIN
  345.                     recursive := True;
  346.                     StartPath := '\';
  347.                   END;
  348.           END;
  349.         END ELSE
  350.           DoError('Unrecognized command option....'+ParamStr(i));
  351.       END else
  352.         {search path}
  353.         StartPath := StUpcase(ParamStr(i));
  354.       i := Succ(i);
  355.     END;
  356.     IF HaltSoon THEN BEGIN
  357.       WriteLn(err, 'Type DISKCHK -? for help....');
  358.       DoHalt(2);
  359.     END;
  360.   END;                        {setoptions}
  361.  
  362.   PROCEDURE SetDTA(VAR dta : DTArec);
  363.     {-set new DTA address}
  364.   BEGIN
  365.     reg.ah := $1A;
  366.     reg.ds := Seg(dta);
  367.     reg.dx := Ofs(dta);
  368.     MsDos(reg);
  369.   END;                        {setdta}
  370.  
  371.   PROCEDURE ScanFiles(StartPath : PathName);
  372.     {-get all files in pathnamed directory}
  373.     {-called recursively in recursive mode}
  374.   VAR
  375.     dirs : Darray;
  376.     dName : DriveName;
  377.     pName, UsePath : PathName;
  378.     fName : FileString;
  379.     filNum : Integer;
  380.     driveNum : Byte;
  381.  
  382.     PROCEDURE ParseDTA(VAR name, ext : FileString);
  383.       {-return a name and extension from a DTA}
  384.     VAR
  385.       i : Byte;
  386.       tempName : FileString;
  387.     BEGIN
  388.       i := 1;
  389.       WHILE dta.FullName[i] <> #0 DO i := Succ(i);
  390.       i := Pred(i);
  391.       Move(dta.FullName, tempName[1], i);
  392.       tempName[0] := Chr(i);
  393.       i := Pos('.', tempName);
  394.       IF i <= 1 THEN BEGIN
  395.         name := tempName;
  396.         ext := '';
  397.       END ELSE BEGIN
  398.         name := Copy(tempName, 1, Pred(i));
  399.         ext := Copy(tempName, Succ(i), 3);
  400.       END;
  401.     END;                      {parsedta}
  402.  
  403.     FUNCTION GetFirst(attr : Integer; VAR StartPath : PathName;
  404.                       VAR name, ext : FileString;
  405.                       VAR rightdirattr : Boolean) : Boolean;
  406.       {-return true and a name if first file is found}
  407.     VAR
  408.       foundone : Boolean;
  409.     BEGIN
  410.       reg.ah := $4E;
  411.       reg.ds := Seg(StartPath);
  412.       reg.dx := Ofs(StartPath[1]);
  413.       reg.cx := attr;
  414.       MsDos(reg);
  415.       foundone := ((reg.flags AND 1) = 0);
  416.       rightdirattr := (dta.attr AND 16) = (attr AND 16);
  417.       IF foundone THEN
  418.         {scan the DTA for the file name and extension}
  419.         ParseDTA(name, ext);
  420.       GetFirst := foundone;
  421.     END;                      {getfirst}
  422.  
  423.     FUNCTION GetNext(attr : Integer; VAR name, ext : FileString;
  424.                      VAR rightdirattr : Boolean) : Boolean;
  425.       {-return true and a name if another file is found}
  426.     VAR
  427.       foundone : Boolean;
  428.     BEGIN
  429.       reg.ah := $4F;
  430.       reg.ds := Seg(dta);
  431.       reg.dx := Ofs(dta);
  432.       MsDos(reg);
  433.       foundone := ((reg.flags AND 1) = 0);
  434.       rightdirattr := (dta.attr AND 16) = (attr AND 16);
  435.       IF foundone THEN
  436.         {scan the DTA for the file name and extension}
  437.         ParseDTA(name, ext);
  438.       GetNext := foundone;
  439.     END;                      {getnext}
  440.  
  441.     PROCEDURE GetFiles(attr : Integer;
  442.                        VAR files : Farray;
  443.                        VAR StartPath : PathName);
  444.       {-return the files in the files array}
  445.     VAR
  446.       tempName, tempExt : FileString;
  447.       rightdir : Boolean;
  448.  
  449.     BEGIN
  450.       WITH files DO BEGIN
  451.         StartPath[Succ(Length(StartPath))] := #0;
  452.         num := 0;
  453.         IF GetFirst(attr, StartPath, tempName, tempExt, rightdir) THEN
  454.           REPEAT
  455.             IF rightdir AND (tempName[1] <> '.') THEN BEGIN
  456.               num := Succ(num);
  457.               WITH arr[num] DO BEGIN
  458.                 name := tempName;
  459.                 ext := tempExt;
  460.               END;
  461.             END;
  462.           UNTIL (num = MaxFiles) OR NOT(GetNext(attr, tempName, tempExt, rightdir));
  463.       END;
  464.     END;                      {getfiles}
  465.  
  466.     PROCEDURE GetDirs(attr : Integer;
  467.                       VAR dirs : Darray;
  468.                       VAR StartPath : PathName);
  469.       {-return the directory names in the dirs array}
  470.     VAR
  471.       tempName, tempExt : FileString;
  472.       rightdir : Boolean;
  473.     BEGIN
  474.       WITH dirs DO BEGIN
  475.         StartPath[Succ(Length(StartPath))] := #0;
  476.         num := 0;
  477.         IF GetFirst(attr, StartPath, tempName, tempExt, rightdir) THEN
  478.           REPEAT
  479.             IF rightdir AND (tempName[1] <> '.') THEN BEGIN
  480.               num := Succ(num);
  481.               arr[num] := tempName;
  482.               IF tempExt <> '' THEN arr[num] := arr[num]+'.'+tempExt;
  483.             END;
  484.           UNTIL (num = MaxDirs) OR NOT(GetNext(attr, tempName, tempExt, rightdir));
  485.       END;
  486.     END;                      {getdirs}
  487.  
  488.     PROCEDURE Analyze(driveNum : Byte; VAR fName : CompositeFilename);
  489.       {-scan the file fname looking for the matchpattern}
  490.     VAR
  491.       FCB : UnopenedFCBrec;
  492.       FCBreturn : UnopenedFCBrec ABSOLUTE dta;
  493.       Breaks, LastCluster, Cluster : Integer;
  494.       EndOfFile : Boolean;
  495.       FATentry : Integer;
  496.       FileClusters : Integer;
  497.       Efficiency : Real;
  498.  
  499.       PROCEDURE InitFCB(VAR FCB : UnopenedFCBrec;
  500.                         driveNum : Byte;
  501.                         name : FileName;
  502.                         ext : ExtName);
  503.         {-set up fcb for directory call}
  504.       BEGIN
  505.         FillChar(FCB, SizeOf(FCB), 32);
  506.         WITH FCB DO BEGIN
  507.           flag := $FF;
  508.           SearchAttr := 7;
  509.           drive := driveNum;
  510.           Move(name[1], fName, Length(name));
  511.           IF Length(ext) > 0 THEN
  512.             Move(ext[1], fExt, Length(ext));
  513.         END;
  514.       END;                    {initfcb}
  515.  
  516.       FUNCTION GetFATentry(Cluster : Integer) : Integer;
  517.         {-return the FAT entry for the specified cluster}
  518.       VAR
  519.         t : Integer;
  520.         oddeven : Integer;
  521.       BEGIN
  522.         IF bigFAT THEN
  523.           Move(FAT^[Cluster SHL 1], t, 2)
  524.         ELSE BEGIN
  525.           oddeven := 3*Cluster;
  526.           Move(FAT^[oddeven SHR 1], t, 2);
  527.           IF Odd(oddeven) THEN
  528.             t := t SHR 4
  529.           ELSE
  530.             t := t AND $FFF;
  531.         END;
  532.         GetFATentry := t;
  533.       END;                    {getfatentry}
  534.  
  535.       FUNCTION LastFATentry(FATentry : Integer) : Boolean;
  536.         {-return true if the last FAT entry for the file}
  537.       BEGIN
  538.         IF bigFAT THEN
  539.           LastFATentry := ((FATentry SHR 4) = $FFF) AND ((FATentry AND $F) >= 8)
  540.         ELSE
  541.           LastFATentry := (FATentry >= $FF8);
  542.       END;                    {lastfatentry}
  543.  
  544.       FUNCTION FormattedName(dname:drivename;
  545.                              pname:pathname;
  546.                              name : FileName;
  547.                              ext : ExtName) : pathname;
  548.         {-return a formatted name right padded with blanks}
  549.       VAR
  550.         t : pathname;
  551.       BEGIN
  552.         t := name;
  553.         IF ext <> '' THEN
  554.           t := t+'.'+ext;
  555.         t:=dname+pname+t;
  556.         WHILE Length(t) < 40 DO t := t+' ';
  557.         FormattedName := t;
  558.       END;                    {formattedname}
  559.  
  560.     BEGIN
  561.  
  562.       IF BreakPressed THEN BreakHalt;
  563.  
  564.       WITH fName DO BEGIN
  565.  
  566.         {fill in the FCB}
  567.         InitFCB(FCB, driveNum, name, ext);
  568.  
  569.         {get detailed directory info from DOS}
  570.         reg.ah := $11;
  571.         reg.ds := Seg(FCB);
  572.         reg.dx := Ofs(FCB);
  573.         MsDos(reg);
  574.         IF reg.al = $FF THEN BEGIN
  575.           WriteLn(err, 'ERROR: file not found... ', name, '.', ext);
  576.           DoHalt(1);
  577.         END;
  578.  
  579.         {found the file, now trace its FAT}
  580.         Cluster := FCBreturn.fCluster;
  581.         LastCluster := Pred(Cluster);
  582.         FileClusters := 1;
  583.         Breaks := 0;
  584.         REPEAT
  585.           IF Cluster <> Succ(LastCluster) THEN
  586.             Breaks := Succ(Breaks);
  587.           FATentry := GetFATentry(Cluster);
  588.           EndOfFile := LastFATentry(FATentry);
  589.           IF NOT EndOfFile THEN BEGIN
  590.             FileClusters := Succ(FileClusters);
  591.             LastCluster := Cluster;
  592.             Cluster := FATentry;
  593.           END;
  594.         UNTIL EndOfFile;
  595.  
  596.         {update counters}
  597.         fCount := Succ(fCount);
  598.         IF Breaks > 0 THEN BEGIN
  599.           fBroken := Succ(fBroken);
  600.           TotalBreaks := TotalBreaks+Breaks;
  601.         END;
  602.         ClustersUsed := ClustersUsed+FileClusters;
  603.         IF FileClusters = 1 THEN
  604.           Efficiency := 100.0
  605.         ELSE
  606.           Efficiency := 100.0*(1.0-Int(Breaks)/Int(FileClusters-1));
  607.  
  608.         IF verbose OR (Efficiency <> 100.0) THEN BEGIN
  609.           WroteFile := True;
  610.           {.F-}
  611.           WriteLn(FormattedName(dname,pname,name,ext),' ',
  612.                   FCBreturn.fCluster:5,' ',
  613.                   FileClusters:5,' ',
  614.                   Breaks:5,' ',
  615.                   1.0*secsize*FileClusters*secsPerAllo:7:0, ' ',
  616.                   efficiency:5:1
  617.                   );
  618.           {.F+}
  619.         END;
  620.       END;
  621.     END;                      {analyze}
  622.  
  623.   BEGIN
  624.     {get a list of all normal, readonly, hidden matching files in startpath}
  625.     ParsePath(StartPath, dName, pName, fName);
  626.     UsePath := dName+pName+fName;
  627.     GetFiles(7, files, UsePath);
  628.  
  629.     {move to the current directory to allow FCBs}
  630.     ChDir(Path('', pName));
  631.     driveNum := ReturnDriveNum(dName);
  632.  
  633.     {check each file}
  634.     FOR filNum := 1 TO files.num DO Analyze(driveNum, files.arr[filNum]);
  635.  
  636.     {look at subdirectories}
  637.     IF recursive THEN BEGIN
  638.       {get all subdirectories}
  639.       UsePath := dName+pName+'*.*';
  640.       GetDirs(19, dirs, UsePath);
  641.       {look in the subdirectories}
  642.       FOR filNum := 1 TO dirs.num DO BEGIN
  643.         {build a pathname to the subdirectory}
  644.         UsePath := dName+pName+dirs.arr[filNum]+'\'+fName;
  645.         {call recursively}
  646.         ScanFiles(UsePath);
  647.       END;
  648.     END;
  649.   END;                        {scanfiles}
  650.  
  651.   PROCEDURE InitializeGlobals;
  652.     {-set up all global data structures}
  653.   BEGIN
  654.     {get default directory and disk}
  655.     GetDir(0, StartPath);
  656.     SavePath := StartPath;
  657.     consoleout:=iostat(1);
  658.     errorptr := Ofs(error);
  659.     Assign(err, 'ERR:');
  660.     Rewrite(err);
  661.     SetBreak;
  662.     SetDTA(dta);
  663.     {set default flags and counters}
  664.     recursive := False;
  665.     verbose := false;
  666.     fCount := 0;
  667.     TotalBreaks := 0;
  668.     ClustersUsed := 0;
  669.     fBroken := 0;
  670.     WroteFile := False;
  671.   END;                        {initializeglobals}
  672.  
  673.   PROCEDURE GetDriveInfo;
  674.     {-determine number of clusters, fat entry size, etc. for the specified drive}
  675.   VAR
  676.     dName : DriveName;
  677.     pName : PathName;
  678.     fName : FileString;
  679.     driveNum : Byte;
  680.     driveid : Byte;
  681.     error : Integer;
  682.     fatofs, sec : Integer;
  683.  
  684.     PROCEDURE getFAT(DOSnum : Byte; VAR driveid : Byte;
  685.                      VAR secSize, alloUnits, secsPerAllo : Integer);
  686.       {-read the FAT ID info for the specified drive}
  687.     BEGIN
  688.       reg.ah := $1C;
  689.       reg.dl := DOSnum;
  690.       MsDos(reg);
  691.       secSize := reg.cx;
  692.       alloUnits := reg.dx;
  693.       secsPerAllo := reg.al;
  694.       driveid := Mem[reg.ds:reg.bx];
  695.     END;                      {getfat}
  696.  
  697.     FUNCTION GetFreeSpace(driveNum : Byte) : Integer;
  698.       {-return the number of free clusters on the drive}
  699.     BEGIN
  700.       reg.ah := $36;
  701.       reg.dl := Succ(driveNum);
  702.       MsDos(reg);
  703.       GetFreeSpace := reg.bx;
  704.     END;                      {GetFreeSpace}
  705.  
  706.     PROCEDURE DOSreadSectors(drive : Byte;
  707.                              LSN : Integer;
  708.                              sects : Integer;
  709.                              VAR buffer;
  710.                              VAR error : Integer);
  711.       {-execute int 25 to read disk through DOS at low level}
  712.     BEGIN
  713.       INLINE(
  714.         $1E/                  {PUSH    DS}
  715.         $8A/$46/$10/          {MOV    AL,[BP+10]}
  716.         $8B/$56/$0E/          {MOV    DX,[BP+0E]}
  717.         $8B/$4E/$0C/          {MOV    CX,[BP+0C]}
  718.         $C5/$5E/$08/          {LDS    BX,[BP+08]}
  719.         $CD/$25/              {INT    25}
  720.         $72/$02/              {JB    0113}
  721.         $31/$C0/              {XOR    AX,AX}
  722.         $9D/                  {POPF    }
  723.         $1F/                  {POP    DS}
  724.         $5D/                  {POP    BP}
  725.         $C4/$7E/$04/          {LES    DI,[BP+04]}
  726.         $26/                  {ES:    }
  727.         $89/$05               {MOV    [DI],AX}
  728.         );
  729.     END;                      {dosreadsectors}
  730.  
  731.     FUNCTION CurrentDrive : Byte;
  732.       {-return the current drive number, 0=A, 1=B}
  733.     BEGIN
  734.       reg.ah := $19;
  735.       MsDos(reg);
  736.       CurrentDrive := reg.al;
  737.     END;                      {currentdrive}
  738.  
  739.   BEGIN
  740.     {break up the starting path}
  741.     ParsePath(StartPath, dName, pName, fName);
  742.  
  743.     {change to the drive we're analyzing}
  744.     IF dName <> '' THEN BEGIN
  745.       ChDir(dName);
  746.       driveNum := ReturnDriveNum(dName)-1; {0=A,1=B}
  747.     END ELSE
  748.       driveNum := CurrentDrive;
  749.  
  750.     {get FAT information}
  751.     getFAT(0, driveid, secSize, alloUnits, secsPerAllo);
  752.  
  753.     {test whether 8 bit or 16 bit fat}
  754.     bigFAT := (alloUnits < 0) OR (alloUnits > 4086);
  755.  
  756.     {allocate memory where we will keep the FAT}
  757.     IF bigFAT THEN
  758.       FATbytes := alloUnits SHL 1
  759.     ELSE
  760.       FATbytes := (3*alloUnits) SHR 1;
  761.     IF FATbytes <= 0 THEN BEGIN
  762.       WriteLn(err, 'Error in FAT size calculation');
  763.       DoHalt(1);
  764.     END;
  765.     GetMem(FAT, FATbytes);
  766.  
  767.     FATsectors := FATbytes DIV secSize;
  768.     IF (FATbytes AND Pred(secSize)) <> 0 THEN FATsectors := Succ(FATsectors);
  769.     {read in the FAT}
  770.     fatofs := 0;
  771.     sec := 1;
  772.     WHILE sec <= FATsectors DO BEGIN
  773.       DOSreadSectors(driveNum, sec, 1, FAT^[fatofs], error);
  774.       IF error <> 0 THEN BEGIN
  775.         WriteLn(err, 'error reading FAT');
  776.         DoHalt(1);
  777.       END;
  778.       sec := Succ(sec);
  779.       fatofs := fatofs+512;
  780.     END;
  781.  
  782.     {get number of available clusters}
  783.     AvailableClusters := GetFreeSpace(driveNum);
  784.  
  785.   END;                        {getdriveinfo}
  786.  
  787.   PROCEDURE WriteResults;
  788.   VAR
  789.     Efficiency : Real;
  790.   BEGIN
  791.     IF ClustersUsed = 1 THEN
  792.       Efficiency := 100.0
  793.     ELSE
  794.       Efficiency := 100.0*(1.0-TotalBreaks/(ClustersUsed-1.0));
  795.     WriteLn(err);
  796.     WriteLn(err, 'total files analyzed               : ', fCount);
  797.     WriteLn(err, 'total clusters used in these files : ', ClustersUsed);
  798.     WriteLn(err, 'total files with cluster breaks    : ', fBroken);
  799.     WriteLn(err, 'total cluster breaks               : ', TotalBreaks);
  800.     WriteLn(err, 'total free clusters on disk        : ', AvailableClusters);
  801.     WriteLn(err, 'total clusters on disk             : ', alloUnits);
  802.     WriteLn(err, 'percent of disk free               : ', (100.0*AvailableClusters/alloUnits):0:1, '%');
  803.     WriteLn(err, 'total bytes on disk                : ', (1.0*secSize*secsPerAllo*alloUnits):0:0);
  804.     WriteLn(err, 'percent of clusters contiguous     : ', Efficiency:0:1, '%');
  805.     IF tStop-tStart <= 0 THEN Exit;
  806.     WriteLn(err, 'file rate                          : ', (fCount/(tStop-tStart)):0:1, ' files/sec');
  807.   END;                        {writeresults}
  808.  
  809. BEGIN
  810.   InitializeGlobals;
  811.   SetOptions;
  812.   WriteLn(err, 'Disk Performance Analyzer - by TurboPower Software - version ',version);
  813.   GetDriveInfo;
  814.   if consoleout then begin
  815.     writeln(err);
  816.     WriteLn(err,'Filename                                Start Clusters Breaks Bytes Effic');
  817.   end;
  818.   Time(tStart);
  819.   ScanFiles(StartPath);
  820.   Time(tStop);
  821.   IF consoleout and not(WroteFile) THEN
  822.     WriteLn(err,'--------------------- none --------------------------');
  823.   WriteResults;
  824.   ChDir(SavePath);
  825. END.
  826.